
; Macroinstructions for defining and calling procedures (x64 version)

macro invoke proc,[arg]
 { common fastcall [proc],arg }

macro fastcall proc,[arg]
 { common local stackspace,argscount,counter
    if argscount < 4
     stackspace = 4*8
    else if argscount and 1
     stackspace = (argscount+1)*8
    else
     stackspace = argscount*8
    end if
    counter = 0
    if stackspace
     if defined current@frame
      if current@frame<stackspace
       current@frame = stackspace
      end if
     else
      if stackspace
       sub rsp,stackspace
      end if
     end if
    end if
   forward
    counter = counter + 1
    define type@param
    define definition@param arg
    match =float value,definition@param
    \{ define definition@param value
       define type@param float \}
    match =addr value,definition@param
    \{ define definition@param value
       define type@param addr \}
    match any=,any,definition@param
    \{ \local ..string,..continue
       jmp ..continue
       align sizeof.TCHAR
       ..string TCHAR definition@param,0
       ..continue:
       define definition@param ..string
       define type@param addr \}
    match any,definition@param
    \{ match \`any,any
       \\{ \\local ..string,..continue
           jmp ..continue
           align sizeof.TCHAR
           ..string TCHAR definition@param,0
           ..continue:
           define definition@param ..string
           define type@param addr \\} \}
    match param,definition@param
    \{ local opcode,origin
       size@param = 0
       if param eqtype 0 | param eqtype 0f | type@param eq addr
        size@param = 8
       else if param eqtype byte 0 | param eqtype byte 0f
        match prefix value,definition@param
         \\{ if prefix eq qword
              size@param = 8
             else if prefix eq dword
              size@param = 4
             else if prefix eq word
              size@param = 2
             else if prefix eq byte
              size@param = 1
             end if \\}
       else if ~ param in <xmm0,xmm1,xmm2,xmm3,xmm4,xmm5,xmm6,xmm7,xmm8,xmm9,xmm10,xmm11,xmm12,xmm13,xmm14,xmm15>
        virtual
         origin = $
         inc param
         load opcode byte from origin
         if opcode = 67h
          load opcode byte from origin+1
         end if
         if opcode and 0F8h = 48h
          size@param = 8
         else if opcode = 66h
          size@param = 2
         else if opcode = 0FFh
          size@param = 4
         else
          size@param = 1
         end if
        end virtual
       end if
       if counter = 1
        if type@param eq float
         if ~ param eq xmm0
          if size@param = 4
           if param eqtype byte 0 | param eqtype byte 0f
            mov eax,param
            movd xmm0,eax
           else
            movd xmm0,param
           end if
          else
           if param eqtype 0 | param eqtype 0f | param eqtype byte 0 | param eqtype byte 0f
            mov rax,param
            movq xmm0,rax
           else
            movq xmm0,param
           end if
          end if
         end if
        else if type@param eq addr
         if ~ param eq rcx
          lea rcx,[param]
         end if
        else if size@param = 8
         if ~ param eq rcx
          mov rcx,param
         end if
        else if size@param = 4
         if ~ param eq ecx
          mov ecx,param
         end if
        else if size@param = 2
         if ~ param eq cx
          mov cx,param
         end if
        else if size@param = 1
         if ~ param eq cl
          mov cl,param
         end if
        end if
       else if counter = 2
        if type@param eq float
         if ~ param eq xmm1
          if size@param = 4
           if param eqtype byte 0 | param eqtype byte 0f
            mov eax,param
            movd xmm1,eax
           else
            movd xmm1,param
           end if
          else
           if param eqtype 0 | param eqtype 0f | param eqtype byte 0 | param eqtype byte 0f
            mov rax,param
            movq xmm1,rax
           else
            movq xmm1,param
           end if
          end if
         end if
        else if type@param eq addr
         if ~ param eq rdx
          lea rdx,[param]
         end if
        else if size@param = 8
         if ~ param eq rdx
          mov rdx,param
         end if
        else if size@param = 4
         if ~ param eq edx
          mov edx,param
         end if
        else if size@param = 2
         if ~ param eq dx
          mov dx,param
         end if
        else if size@param = 1
         if ~ param eq dl
          mov dl,param
         end if
        end if
       else if counter = 3
        if type@param eq float
         if ~ param eq xmm2
          if size@param = 4
           if param eqtype byte 0 | param eqtype byte 0f
            mov eax,param
            movd xmm2,eax
           else
            movd xmm2,param
           end if
          else
           if param eqtype 0 | param eqtype 0f | param eqtype byte 0 | param eqtype byte 0f
            mov rax,param
            movq xmm2,rax
           else
            movq xmm2,param
           end if
          end if
         end if
        else if type@param eq addr
         if ~ param eq r8
          lea r8,[param]
         end if
        else if size@param = 8
         if ~ param eq r8
          mov r8,param
         end if
        else if size@param = 4
         if ~ param eq r8d
          mov r8d,param
         end if
        else if size@param = 2
         if ~ param eq r8w
          mov r8w,param
         end if
        else if size@param = 1
         if ~ param eq r8b
          mov r8b,param
         end if
        end if
       else if counter = 4
        if type@param eq float
         if ~ param eq xmm3
          if size@param = 4
           if param eqtype byte 0 | param eqtype byte 0f
            mov eax,param
            movd xmm3,eax
           else
            movd xmm3,param
           end if
          else
           if param eqtype 0 | param eqtype 0f | param eqtype byte 0 | param eqtype byte 0f
            mov rax,param
            movq xmm3,rax
           else
            movq xmm3,param
           end if
          end if
         end if
        else if type@param eq addr
         if ~ param eq r9
          lea r9,[param]
         end if
        else if size@param = 8
         if ~ param eq r9
          mov r9,param
         end if
        else if size@param = 4
         if ~ param eq r9d
          mov r9d,param
         end if
        else if size@param = 2
         if ~ param eq r9w
          mov r9w,param
         end if
        else if size@param = 1
         if ~ param eq r9b
          mov r9b,param
         end if
        end if
       else
         if type@param eq addr
          lea rax,[param]
          mov [rsp+(counter-1)*8],rax
         else if param eqtype [0] | param eqtype byte [0]
          if size@param = 8
           mov rax,param
           mov [rsp+(counter-1)*8],rax
          else if size@param = 4
           mov eax,param
           mov [rsp+(counter-1)*8],eax
          else if size@param = 2
           mov ax,param
           mov [rsp+(counter-1)*8],ax
          else
           mov al,param
           mov [rsp+(counter-1)*8],al
          end if
         else if size@param = 8
          virtual
           origin = $
           mov rax,param
           load opcode byte from origin+1
          end virtual
          if opcode = 0B8h
           mov rax,param
           mov [rsp+(counter-1)*8],rax
          else
           mov qword [rsp+(counter-1)*8],param
          end if
         else if param in <xmm0,xmm1,xmm2,xmm3,xmm4,xmm5,xmm6,xmm7,xmm8,xmm9,xmm10,xmm11,xmm12,xmm13,xmm14,xmm15>
          movq [rsp+(counter-1)*8],param
         else
          mov [rsp+(counter-1)*8],param
         end if
       end if \}
   common
    argscount = counter
    call proc
    if stackspace & ~defined current@frame
     add rsp,stackspace
    end if }

macro proc [args]
 { common
    match name params, args>
    \{ define@proc name,<params \} }

prologue@proc equ prologuedef

macro prologuedef procname,flag,parmbytes,localbytes,reglist
 { local loc,fill,counter
   loc = (localbytes+15) and (not 15)
   parmbase@proc equ rbp+16
   localbase@proc equ rbp-loc
   if parmbytes | localbytes
    push rbp
    mov rbp,rsp
    if loc+fill
     sub rsp,loc+fill
    end if
   end if
   counter = 0
   irps reg, reglist \{ push reg
                        counter = counter+1 \}
   fill = 8*(counter and 1) }

epilogue@proc equ epiloguedef

macro epiloguedef procname,flag,parmbytes,localbytes,reglist
 { irps reg, reglist \{ reverse pop reg \}
   if parmbytes | localbytes
    leave
   end if
   retn }

close@proc equ

macro define@proc name,statement
 { local params,flag,regs,parmbytes,localbytes,current
   if used name
   name:
   match =stdcall args, statement \{ params equ args
                                     flag = 11b \}
   match =stdcall, statement \{ params equ
                                flag = 11b \}
   match =c args, statement \{ params equ args
                               flag = 10001b \}
   match =c, statement \{ params equ
                          flag = 10001b \}
   match =params, params \{ params equ statement
                            flag = 10000b \}
   match =uses reglist=,args, params \{ regs equ reglist
                                        params equ args \}
   match =regs =uses reglist, regs params \{ regs equ reglist
                                             params equ \}
   match =regs, regs \{ regs equ \}
   match prologue:reglist, prologue@proc:<regs> \{ prologue name,flag,parmbytes,localbytes,reglist \}
   virtual at parmbase@proc
   match =,args, params \{ defargs@proc args \}
   match =args@proc args, args@proc params \{ defargs@proc args \}
   parmbytes = $-(parmbase@proc)
   end virtual
   name # % = parmbytes/8
   all@vars equ
   current = 0
   macro locals
   \{ virtual at localbase@proc+current
      macro label def \\{ match . type,def> \\\{ deflocal@proc .,label,<type \\\} \\}
      struc db [val] \\{ \common deflocal@proc .,db,val \\}
      struc du [val] \\{ \common deflocal@proc .,du,val \\}
      struc dw [val] \\{ \common deflocal@proc .,dw,val \\}
      struc dp [val] \\{ \common deflocal@proc .,dp,val \\}
      struc dd [val] \\{ \common deflocal@proc .,dd,val \\}
      struc dt [val] \\{ \common deflocal@proc .,dt,val \\}
      struc dq [val] \\{ \common deflocal@proc .,dq,val \\}
      struc rb cnt \\{ deflocal@proc .,rb cnt, \\}
      struc rw cnt \\{ deflocal@proc .,rw cnt, \\}
      struc rp cnt \\{ deflocal@proc .,rp cnt, \\}
      struc rd cnt \\{ deflocal@proc .,rd cnt, \\}
      struc rt cnt \\{ deflocal@proc .,rt cnt, \\}
      struc rq cnt \\{ deflocal@proc .,rq cnt, \\} \}
   macro endl
   \{ purge label
      restruc db,du,dw,dp,dd,dt,dq
      restruc rb,rw,rp,rd,rt,rq
      current = $-(localbase@proc)
      end virtual \}
   macro ret operand
   \{ match any, operand \\{ retn operand \\}
      match , operand \\{ match epilogue:reglist, epilogue@proc:<regs> \\\{ epilogue name,flag,parmbytes,localbytes,reglist \\\} \\} \}
   macro finish@proc
   \{ localbytes = current
      match close:reglist, close@proc:<regs> \\{ close name,flag,parmbytes,localbytes,reglist \\}
      end if \} }

macro defargs@proc [arg]
 { common
    if ~ arg eq
   forward
     local ..arg,current@arg
     match argname:type, arg
      \{ current@arg equ argname
         label ..arg type
         argname equ ..arg
         if qqword eq type
           dq ?,?,?,?
         else if dqword eq type
           dq ?,?
         else if tbyte eq type
           dq ?,?
         else
           dq ?
         end if \}
     match =current@arg,current@arg
      \{ current@arg equ arg
         arg equ ..arg
         ..arg dq ? \}
   common
     args@proc equ current@arg
   forward
     restore current@arg
   common
    end if }

macro deflocal@proc name,def,[val] { name def val }

macro deflocal@proc name,def,[val]
 { common
    match vars, all@vars \{ all@vars equ all@vars, \}
    all@vars equ all@vars name
   forward
    local ..var,..tmp
    ..var def val
    match =?, val \{ ..tmp equ \}
    match any =?, val \{ ..tmp equ \}
    match any (=?), val \{ ..tmp equ \}
    match =label, def \{ ..tmp equ \}
    match tmp : value, ..tmp : val
     \{ tmp: end virtual
        initlocal@proc ..var,def value
        virtual at tmp\}
   common
    match first rest, ..var, \{ name equ first \} }

struc label type { label . type }

macro initlocal@proc name,def
 { virtual at name
    def
    size@initlocal = $ - name
   end virtual
   position@initlocal = 0
   while size@initlocal > position@initlocal
    virtual at name
     def
     if size@initlocal - position@initlocal < 2
      current@initlocal = 1
      load byte@initlocal byte from name+position@initlocal
     else if size@initlocal - position@initlocal < 4
      current@initlocal = 2
      load word@initlocal word from name+position@initlocal
     else if size@initlocal - position@initlocal < 8
      current@initlocal = 4
      load dword@initlocal dword from name+position@initlocal
     else
      load qword@initlocal dword from name+position@initlocal
      if ( qword@initlocal > 0 & qword@initlocal < 80000000h ) | ( qword@initlocal < 0 & qword@initlocal >= -80000000h )
       current@initlocal = 8
      else
       current@initlocal = 4
       dword@initlocal = qword@initlocal and 0FFFFFFFFh
      end if
     end if
    end virtual
    if current@initlocal = 1
     mov byte [name+position@initlocal],byte@initlocal
    else if current@initlocal = 2
     mov word [name+position@initlocal],word@initlocal
    else if current@initlocal = 4
     mov dword [name+position@initlocal],dword@initlocal
    else
     mov qword [name+position@initlocal],qword@initlocal
    end if
    position@initlocal = position@initlocal + current@initlocal
   end while }

macro endp
 { purge ret,locals,endl
   finish@proc
   purge finish@proc
   restore regs@proc
   match all,args@proc \{ restore all \}
   restore args@proc
   match all,all@vars \{ restore all \} }

macro local [var]
 { common
    locals
   forward done@local equ
    match varname[count]:vartype, var
    \{ match =BYTE, vartype \\{ varname rb count
                                restore done@local \\}
       match =WORD, vartype \\{ varname rw count
                                restore done@local \\}
       match =DWORD, vartype \\{ varname rd count
                                 restore done@local \\}
       match =PWORD, vartype \\{ varname rp count
                                 restore done@local \\}
       match =QWORD, vartype \\{ varname rq count
                                 restore done@local \\}
       match =TBYTE, vartype \\{ varname rt count
                                 restore done@local \\}
       match =DQWORD, vartype \\{ label varname dqword
                                  rq count*2
                                  restore done@local \\}
       match =QQWORD, vartype \\{ label varname qqword
                                  rq count*4
                                  restore done@local \\}
       match =XWORD, vartype \\{ label varname xword
                                 rq count*2
                                 restore done@local \\}
       match =YWORD, vartype \\{ label varname yword
                                 rq count*4
                                 restore done@local \\}
       match , done@local \\{ virtual
                               varname vartype
                              end virtual
                              rb count*sizeof.\#vartype
                              restore done@local \\} \}
    match :varname:vartype, done@local:var
    \{ match =BYTE, vartype \\{ varname db ?
                                restore done@local \\}
       match =WORD, vartype \\{ varname dw ?
                                restore done@local \\}
       match =DWORD, vartype \\{ varname dd ?
                                 restore done@local \\}
       match =PWORD, vartype \\{ varname dp ?
                                 restore done@local \\}
       match =QWORD, vartype \\{ varname dq ?
                                 restore done@local \\}
       match =TBYTE, vartype \\{ varname dt ?
                                 restore done@local \\}
       match =DQWORD, vartype \\{ label varname dqword
                                  dq ?,?
                                  restore done@local \\}
       match =QQWORD, vartype \\{ label varname qqword
                                  dq ?,?,?,?
                                  restore done@local \\}
       match =XWORD, vartype \\{ label varname xword
                                 dq ?,?
                                 restore done@local \\}
       match =YWORD, vartype \\{ label varname yword
                                 dq ?,?,?,?
                                 restore done@local \\}
       match , done@local \\{ varname vartype
                              restore done@local \\} \}
    match ,done@local
    \{ var
       restore done@local \}
   common
    endl }

macro frame
 { local size,current
   if size
    sub rsp,size
   end if
   current = 0
   current@frame equ current
   size@frame equ size }

macro endf
 { size@frame = current@frame
   if size@frame
    add rsp,size@frame
   end if
   restore size@frame,current@frame }

macro static_rsp_prologue procname,flag,parmbytes,localbytes,reglist
 { local counter,loc,frame,current 
   counter = 0 
   irps reg, reglist \{ push reg 
                        counter = counter+1 \} 
   loc = (localbytes+7) and (not 7) 
   if frame & (counter+loc shr 3+1) and 1 
    loc = loc + 8 
   end if 
   framebytes@proc equ frame+loc 
   if framebytes@proc 
    sub rsp,framebytes@proc 
   end if 
   localbase@proc equ rsp+frame 
   regsbase@proc equ rsp+frame+loc 
   parmbase@proc equ rsp+frame+loc+counter*8+8 
   current = 0 
   current@frame equ current 
   size@frame equ frame } 

macro static_rsp_epilogue procname,flag,parmbytes,localbytes,reglist 
 { if framebytes@proc 
    add rsp,framebytes@proc 
   end if 
   irps reg, reglist \{ reverse pop reg \} 
   retn } 

macro static_rsp_close procname,flag,parmbytes,localbytes,reglist 
 { size@frame = current@frame 
   restore size@frame,current@frame }

stdcall fix fastcall
ccall fix fastcall
cinvoke fix invoke
